home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 20 / Cream of the Crop 20 (Terry Blount) (1996).iso / program / prtfrm51.zip / FRMSRC.ZIP / FDEMO01.PAS < prev    next >
Pascal/Delphi Source File  |  1996-06-20  |  2KB  |  88 lines
  1. unit Fdemo01;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, PrnWin, CB_Types, Printers;
  8.  
  9. type
  10.   TForm01 = class(TForm)
  11.     View: TBitBtn;
  12.     PrintWin1: TPrintWin;
  13.     Memo1: TMemo;
  14.     Memo2: TMemo;
  15.     Exit: TBitBtn;
  16.     procedure ViewClick(Sender: TObject);
  17.     procedure ExitClick(Sender: TObject);
  18.   private
  19.     { Private declarations }
  20.   public
  21.         procedure DrawIt( FontName: string; x: Real; y: Real );
  22.   end;
  23.  
  24. var
  25.   Form01: TForm01;
  26.  
  27. implementation
  28.  
  29. {$R *.DFM}
  30.  
  31. procedure TForm01.ViewClick(Sender: TObject);
  32. begin
  33.     PrintWin1.HeaderStringCenter := Printer.Printers[Printer.PrinterIndex];
  34.     PrintWin1.HeaderStringRight := 'Font Test';
  35.     PrintWin1.BeginPrint;
  36.  
  37.  
  38.    DrawIt ('Arial', 0.25, 1.0);
  39.    DrawIt ('Times New Roman', 0.25, 3.0);
  40.    DrawIt ('Courier New', 0.25, 5.0);
  41.  
  42.    PrintWin1.NewFont ('Courier New',12,True,True,False);
  43.  
  44.     Memo1.Visible := True;
  45.    PrintWin1.DrawWindow(7,poCenter,Memo1);
  46.    Memo1.Visible := False;
  47.     PrintWin1.EndPrint;
  48. end;
  49.  
  50. procedure TForm01.DrawIt( FontName: string; x: Real; y: Real );
  51. var
  52.     i: Integer;
  53.     Width: Real;
  54.    Height: Real;
  55.    str: string;
  56.    Name: string;
  57. begin
  58.    PrintWin1.NewFont (FontName,18,True,True,False);
  59.  
  60.    PrintWin1.DrawText( y ,poCenter, FontName);
  61.  
  62.    Name := 'Test String';
  63.    Width := PrintWin1.GetTextWidth(Name);
  64.    Height := PrintWin1.GetTextHeight(Name);
  65.    PrintWin1.NewFont (FontName,12,True,True,False);
  66.  
  67.    for i := 0 to 5 do begin
  68.       str := '('+FloatToStrF(Width,ffFixed,5,2)+','+FloatToStrF(Height,ffFixed,5,2)+')';
  69.       PrintWin1.DrawTextAt( x, y - Height, str);
  70.       PrintWin1.DrawRectAt( x, y, x+Width, y+Height);
  71.       PrintWin1.DrawTextAt( x,y,Name);
  72.       x := x + Width;
  73.       y := y + Height;
  74.  
  75.       PrintWin1.NewFont (FontName,12+((i+1)*4),True,True,False);
  76.        Width := PrintWin1.GetTextWidth(Name);
  77.        Height := PrintWin1.GetTextHeight(Name);
  78.  
  79.    end;
  80. end;
  81.  
  82. procedure TForm01.ExitClick(Sender: TObject);
  83. begin
  84.     Close;
  85. end;
  86.  
  87. end.
  88.